home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / Obrn-A_1.6_lib.lha / oberon-a / source3.lha / source / 3rdParty / IntuiSupUtil.mod < prev    next >
Text File  |  1995-06-29  |  4KB  |  157 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: IntuiSupUtil.mod $
  4.   Description: Support for clients of intuisup.library.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 2.9 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/04 23:11:42 $
  10.  
  11.   Copyright © 1994-1995, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. <* STANDARD- *>
  18.  
  19. MODULE IntuiSupUtil;
  20.  
  21. IMPORT SYS := SYSTEM, e := Exec, i := Intuition, is := IntuiSup;
  22.  
  23. (*------------------------------------------------------------------------*)
  24. (* Procedures for Gadgets *)
  25.  
  26. CONST
  27.   disableFlag = {is.gdDisabled};
  28.   noFlag = {};
  29.  
  30.  
  31. (*------------------------------------------------------------------------*)
  32. (* Procedures for AutoRequesters *)
  33.  
  34. CONST
  35.   noIDCMPFlags = {};
  36.   autoReqFlags = {is.arMovePointerNeg, is.arDrawRaster};
  37.   acceptText = "Accept";
  38.   cancelText = "Cancel";
  39.   continueText = "Continue";
  40.  
  41.  
  42. (*------------------------------------------------------------------------*)
  43. (* Procedures for Gadgets *)
  44.  
  45. (*------------------------------------*)
  46. PROCEDURE DisableGadget *
  47.   ( gadgetList : is.GadgetList;
  48.     gadget     : INTEGER;
  49.     disableIt  : BOOLEAN);
  50.  
  51.   VAR ignore : LONGINT;
  52.  
  53. BEGIN (* DisableGadget *)
  54.   IF disableIt THEN
  55.     ignore :=
  56.       is.SetGadgetAttributes (
  57.         gadgetList, gadget, disableFlag, disableFlag,
  58.         is.useCurrentValue, is.useCurrentValue,
  59.         is.useCurrentValue);
  60.   ELSE
  61.     ignore :=
  62.       is.SetGadgetAttributes (
  63.         gadgetList, gadget, disableFlag, noFlag,
  64.         is.useCurrentValue, is.useCurrentValue,
  65.         is.useCurrentValue);
  66.   END; (* ELSE *)
  67. END DisableGadget;
  68.  
  69.  
  70. (*------------------------------------*)
  71. PROCEDURE SelectGadget *
  72.   ( gadgetList : is.GadgetList;
  73.     gadget     : INTEGER;
  74.     selectIt   : BOOLEAN);
  75.  
  76.   VAR ignore, value : LONGINT;
  77.  
  78. BEGIN (* SelectGadget *)
  79.   IF selectIt THEN value := 1 ELSE value := 0 END;
  80.   ignore :=
  81.     is.SetGadgetAttributes (
  82.       gadgetList, gadget, noFlag, noFlag, value, is.useCurrentValue,
  83.       is.useCurrentValue);
  84. END SelectGadget;
  85.  
  86.  
  87. (*------------------------------------*)
  88. PROCEDURE SetGadget *
  89.   ( gadgetList : is.GadgetList;
  90.     gadget     : INTEGER;
  91.     gadgetType : INTEGER;
  92.     value      : LONGINT);
  93.  
  94.   VAR ignore : LONGINT;
  95.  
  96. BEGIN (* SetGadget *)
  97.   CASE gadgetType OF
  98.     is.button, is.check :
  99.       ignore :=
  100.         is.SetGadgetAttributes
  101.           ( gadgetList, gadget, noFlag, noFlag, value, is.useCurrentValue,
  102.             is.useCurrentValue);
  103.     |
  104.     is.mx, is.cycle :
  105.       ignore :=
  106.         is.SetGadgetAttributes
  107.           ( gadgetList, gadget, noFlag, noFlag, is.useCurrentValue, value,
  108.             is.useCurrentValue);
  109.     |
  110.   ELSE
  111.     ignore :=
  112.       is.SetGadgetAttributes
  113.         ( gadgetList, gadget, noFlag, noFlag, is.useCurrentValue,
  114.           is.useCurrentValue, value);
  115.   END; (* CASE gadgetType *)
  116. END SetGadget;
  117.  
  118.  
  119. (*------------------------------------------------------------------------*)
  120. (* Procedures for AutoRequesters *)
  121.  
  122.  
  123. (*------------------------------------*)
  124. PROCEDURE DoRequest *
  125.   ( reqWin   : i.WindowPtr;
  126.     title    : e.LSTRPTR;
  127.     bodyText : ARRAY OF CHAR )
  128.   : BOOLEAN;
  129.  
  130. <*$CopyArrays-*>
  131. BEGIN (* DoRequest *)
  132.   RETURN
  133.     is.AutoRequest
  134.       ( reqWin, title, bodyText, SYS.ADR(acceptText), SYS.ADR(cancelText),
  135.         noIDCMPFlags, noIDCMPFlags, autoReqFlags, NIL);
  136. END DoRequest;
  137.  
  138.  
  139. (*------------------------------------*)
  140. PROCEDURE DoNotice *
  141.   ( reqWin : i.WindowPtr;
  142.     title    : e.LSTRPTR;
  143.     bodyText : ARRAY OF CHAR );
  144.  
  145.   VAR ignore : BOOLEAN;
  146.  
  147. <*$CopyArrays-*>
  148. BEGIN (* DoNotice *)
  149.   ignore :=
  150.     is.AutoRequest
  151.       ( reqWin, title, bodyText, NIL, SYS.ADR(continueText), noIDCMPFlags,
  152.         noIDCMPFlags, autoReqFlags, NIL);
  153. END DoNotice;
  154.  
  155. END IntuiSupUtil.
  156.  
  157.